home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 11 / AMUG BBS in a Box Volume XI (April 1994) (MacWizards).iso / Files / Util / R / Rotenstien1.sit / DailySource < prev    next >
Encoding:
Text File  |  1989-03-04  |  8.1 KB  |  291 lines  |  [TEXT/PJMM]
  1. PROGRAM DailyOrganiser;
  2.  
  3. { Daily Organiser is a hierarchical joke program, showing what may    }
  4. { happen if programmers go too far. It uses the new hierarchical        }
  5. { menus in system 4.1 and later (it bombs on earlier systems).            }
  6.  
  7. { Hierarchical menus are formed like any other menu, but are inserted    }
  8. { with 'InsertMenu' before menu ID -1, and referenced by a menu item    }
  9. { with command key equivalent $1B, with the check mark pointing to    }
  10. { the menu to be shown.                                                        }
  11.  
  12. { If an item is chosen which has a hierarchical menu attached,             }
  13. { 'MenuSelect' returns a zero, as if no item was chosen. Similarly, if    }
  14. { an item with hierarchical menu attached is disabled, the hierarchical    }
  15. { menu does not appear.                                                        }
  16.  
  17. { Daily Organiser uses the International Utilities to obtain the names of    }
  18. { months, and to calculate times. Therefore, if used in, say, Germay    }
  19. { where a 24hr clock is used, the months will appear in German and        }
  20. { the times in the 24hr clock system. Pretty neat, eh?                    }
  21.  
  22. { To use, simply compile, add accompanying resources, and set the        }
  23. { creator to 'Dag!'.  Enjoy!                                                    }
  24.  
  25. { Daily Organiser is © 1987 by John Rotenstein.                            }
  26. { Originally programming in LightSpeed Pascal.                            }
  27. { This source code, relevant resources and complete applications may    }
  28. { be distributed for non-profit purposes.  Feedback welcome.            }
  29.  
  30. { Now, on with the show… }
  31.  
  32.  
  33.     CONST
  34.         hMenuCmd = $1B;     {itemCmd == $1B ==> hierarchical menu}
  35.         hierMenu = -1;        {a hierarchical menu - for InsertMenu call}
  36.  
  37.         appleMenu = 1;        { ID numbers of menus }
  38.         fileMenu = 2;
  39.         editMenu = 3;
  40.         dailyMenu = 10;
  41.         jobMenu = 14;
  42.  
  43.     VAR
  44.         Alrt : integer;
  45.         appleMenuH, fileMenuH, editMenuH, dailyMenuH : MenuHandle;
  46.         SysStrH : StringHandle;
  47.         SysStr : Str255;
  48.         quitting : Boolean;
  49.  
  50. {-----------------------------------------------------------}
  51.  
  52.     PROCEDURE SetItemCmd (menu : MenuHandle;
  53.                                     item : INTEGER;
  54.                                     cmdChar : CHAR);
  55.     INLINE
  56.         $A84F;            { New command added for hierarchical usage }
  57.  
  58. {-----------------------------------------------------------}
  59.  
  60.     PROCEDURE Init;    { All the interesting stuff }
  61.  
  62.         CONST
  63.             MBAR = 1;                    { ID of MBAR resource }
  64.  
  65.         VAR
  66.             menuBar : Handle;
  67.             Intl : Intl1Hndl;                { Handle to international resource }
  68.             theString : Str255;
  69.             index : integer;
  70.             indexL, time : longint;
  71.             menuH : MenuHandle;
  72.  
  73.     BEGIN
  74.         quitting := false;
  75.  
  76.         menuBar := GetNewMBar(MBAR);
  77.         SetMenuBar(menuBar);
  78.         DisposHandle(menuBar);
  79.  
  80.         appleMenuH := GetMHandle(appleMenu);    { Get menu handles of menus }
  81.         fileMenuH := GetMHandle(fileMenu);        { loaded with 'SetMenuBar'.    }
  82.         editMenuH := GetMHandle(editMenu);
  83.         dailyMenuH := GetMHandle(dailyMenu);
  84.         AddResMenu(appleMenuH, 'DRVR');            { Add DAs }
  85.         DrawMenuBar;
  86.  
  87. { Side Note: If you add menus after 'DrawMenuBar', you can get an interesting    }
  88. { effect with the new system.    See the application 'Magic Menus' for an e.g.        }
  89.  
  90.         FOR index := 4 TO 7 DO
  91.             InsertMenu(GetMenu(index), hierMenu);
  92.  
  93. { The hierarchical menus can't be added with 'Get/SetMenuBar'.        }
  94. { They must be added with InsertMenu, before menu ID '-1'.            }
  95.  
  96.         index := 1;
  97.         FOR indexL := 1987 TO 1992 DO            { Change as appropriate }
  98.             BEGIN
  99.                 NumtoString(indexL, theString);        { Converts from # to string }
  100.                 AppendMenu(dailyMenuH, theString);
  101.                 SetItemCmd(dailyMenuH, index, chr(hMenuCmd));    { Make hierarchical }
  102.                 SetItemMark(dailyMenuH, index, chr(11));    { Link each item to menu ID 11 }
  103.                 index := index + 1
  104.             END;
  105.  
  106.         Intl := Intl1Hndl(IUGetIntl(1));
  107.         menuH := NewMenu(11, 'Month');
  108.         InsertMenu(menuH, hierMenu);
  109.         WITH Intl^^ DO
  110.             FOR index := 1 TO 12 DO
  111.                 BEGIN
  112.                     AppendMenu(menuH, months[index]);                { Months from Intl resource }
  113.                     SetItemCmd(menuH, index, chr(hMenuCmd));    { Make hierarchical }
  114.                     SetItemMark(menuH, index, chr(12))    { Link each item to menu ID 12 }
  115.                 END;
  116.         DisposHandle(Handle(Intl));
  117.  
  118.         menuH := NewMenu(12, 'Day');
  119.         InsertMenu(menuH, hierMenu);
  120.         FOR index := 1 TO 31 DO
  121.             BEGIN
  122.                 NumToString(index, theString);
  123.                 AppendMenu(menuH, theString);
  124.                 SetItemCmd(menuH, index, chr(hMenuCmd));    { Make hierarchical }
  125.                 SetItemMark(menuH, index, chr(13))        { Link each item to menu ID 13 }
  126.             END;
  127.  
  128. { The time routine below calculates the time by half hour intervals (1800 secs)    }
  129. { and then asks the International Routines to calculate the ASCII readout.            }
  130. { Longints must be used in these time calculations, but normal integers for menus.}
  131.  
  132.         menuH := NewMenu(13, 'Hour');
  133.         InsertMenu(menuH, hierMenu);
  134.         index := 1;
  135.         FOR indexL := 14 TO 40 DO
  136.             BEGIN
  137.                 time := indexL * 1800;
  138.                 IUTimeString(time, false, theString);
  139.                 AppendMenu(menuH, theString);
  140.                 SetItemCmd(menuH, index, chr(hMenuCmd));    { Make hierarchical }
  141.                 SetItemMark(menuH, index, chr(14));        { Link each item to menu ID 13 }
  142.                 index := index + 1
  143.             END;
  144.  
  145. { Note that no serious program would link every menu item to the same    }
  146. { hierarchical menu. There is no way of knowing which route the user took    }
  147. { to arrive at the menu selection.  Separate menus would have to be        }
  148. { created, but these could be generated with the one menu resource, but    }
  149. { with different IDs!                                                                }
  150.  
  151.         menuH := NewMenu(14, 'Jobs');
  152.         InsertMenu(menuH, hierMenu);
  153.         index := 1;
  154.         REPEAT
  155.             GetIndString(theString, 1, index);
  156.             IF theString <> '' THEN
  157.                 AppendMenu(menuH, theString);
  158.             index := index + 1
  159.         UNTIL theString = '';
  160.  
  161. { You may add jobs by adding entries into the STR# 1 resource.    }
  162.  
  163.     END; {Init}
  164.  
  165. {-----------------------------------------------------------}
  166.  
  167.     PROCEDURE AlrtProc (alertnum : integer);
  168.  
  169. { Poorly named. Actually brings up the requested dialog box and waits for    }
  170. { a key press, mouse down, or disk-insert event. Caters for background    }
  171. { updating of windows in MultiFinder by continually calling 'EventAvail'        }
  172. { and is friendly to DAs by calling 'SystemTask'.                                }
  173.  
  174.         VAR
  175.             theDialog : DialogPtr;
  176.             oldPort : GrafPtr;
  177.             theEvt : EventRecord;
  178.  
  179.     BEGIN
  180.  
  181.         GetPort(oldPort);
  182.         theDialog := GetNewDialog(alertnum, NIL, pointer(-1));
  183.         SetPort(theDialog);
  184.         DrawDialog(theDialog);            { Must manually draw as no dialog routines used }
  185.         HiliteMenu(0);                    { Turn off menu hilight }
  186.         REPEAT
  187.             SystemTask
  188.         UNTIL (EventAvail(mDownMask + keyDownMask + diskMask, theEvt)) AND (theEvt.what <> nullEvent);
  189.         CloseDialog(theDialog);
  190.         SetPort(oldPort)
  191.  
  192.     END; {AlrtProc}
  193.  
  194. {-----------------------------------------------------------}
  195.  
  196.     PROCEDURE DoCommand (mResult : longint);
  197.  
  198. { Handles menu choices }
  199.  
  200.         VAR
  201.             theItem, theMenu, temp : integer;
  202.             name : Str255;
  203.             tempB : boolean;
  204.  
  205.     BEGIN
  206.         theItem := LoWord(mResult);
  207.         theMenu := HiWord(mResult);
  208.  
  209.         CASE theMenu OF
  210.  
  211.             appleMenu : 
  212.                 IF theItem <> 1 THEN
  213.                     BEGIN
  214.                         GetItem(appleMenuH, theItem, name);
  215.                         temp := OpenDeskAcc(name);
  216.                     END;
  217.  
  218.             fileMenu : 
  219.                 quitting := true;
  220.  
  221.             editMenu : 
  222.                 tempB := SystemEdit(theItem - 1);
  223.  
  224.             jobMenu : 
  225.                 AlrtProc(1);
  226.  
  227.             OTHERWISE       { This command may not be available in all versions of pascal }
  228.                 ; {ignore it}
  229.  
  230.         END; {of menu case}
  231.         HiliteMenu(0)
  232.  
  233.     END; {DoCommand}
  234.  
  235. {-----------------------------------------------------------}
  236.  
  237.     PROCEDURE DoEvent;
  238.         VAR
  239.             theEvent : EventRecord;
  240.             theChar : Char;
  241.             whichWindow : WindowPtr;
  242.  
  243.     BEGIN
  244.         IF GetNextEvent(everyEvent, theEvent) THEN
  245.             CASE theEvent.what OF
  246.  
  247.                 mouseDown : 
  248.  
  249.                     CASE FindWindow(theEvent.where, whichWindow) OF
  250.  
  251.                         inSysWindow : 
  252.                             SystemClick(theEvent, whichWindow);
  253.  
  254.                         inMenuBar : 
  255.                             DoCommand(MenuSelect(theEvent.where));
  256.  
  257.                         OTHERWISE
  258.                             ; {ignore it}
  259.  
  260.                     END; {mouseDown}
  261.  
  262.                 OTHERWISE
  263.                     ; {ignore it}
  264.  
  265.             END; {case event}
  266.  
  267.     END; {DoEvent}
  268. {-----------------------------------------------------------}
  269.  
  270. BEGIN
  271.     SysStrH := GetString(0);            { Get system version string}
  272.     SysStr := SysStrH^^;
  273.     DisposHandle(Handle(SysStrH));
  274.  
  275. { This alert box ensures the required system is being used.    }
  276. { Once the 'SysEnvirons' call gets going, it will be a simple    }
  277. { process to automate, but until then…                            }
  278.  
  279.     ParamText(SysStr, '', '', '');
  280.     InitCursor;
  281.     Alrt := Alert(1, NIL);
  282.     IF Alrt = 1 THEN                { 'Continue' }
  283.  
  284.         BEGIN
  285.             Init;                            { Do once-only stuff }
  286.             REPEAT
  287.                 DoEvent                    { Do main loop }
  288.             UNTIL quitting
  289.         END
  290.  
  291. END. {DailyOrganiser}